home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr40 / aprs67.zip / CONV100B.BAS < prev    next >
BASIC Source File  |  1995-02-20  |  16KB  |  399 lines
  1. REM Program name: CONV100b.BAS
  2.  
  3. REM **********  FOR INSTRUCTIONS, SEE README.100
  4.  
  5. REM This program takes the USGS cd rom 1 TO 100,000 Digital Line Graph
  6. REM "Optional Format" output and converts it into the same format as the
  7. REM 1 to 2,000,000 Graphic Format output which APRS MAPFIX can read.
  8. REM ************** MODIFICATION HISTORY ****************
  9. REM 24AUG94  W7KKE  Expanded menu to include other types of water boundaries.
  10. REM 4 Nov    WB4APR Instead of prompting user, now program just generates and
  11. REM                 names files for all the features in the given type
  12. REM 15Nov94  W7KKE  Picked up the second attribute code when the first
  13. REM                 was an "incidental feature". Due to CD ROM digitizing
  14. REM                 techniques this was causing lines which ran due east/west
  15. REM                 or north/south to be lost.
  16. REM 17Nov94  W7KKE  Corrected lat/long calculations for UTM grid rotation.
  17. REM 08Jan94  W7KKE  Added "Far Shore" & "Near Shore" water body attribute
  18. REM                 to pick up rivers.
  19. REM 20Feb94  WB4APR changed line 81 to remove TEST line. Renamed CONV100b
  20.  
  21. 'Declare x and y as long variables
  22. DIM lon AS DOUBLE
  23. DIM x(400) AS LONG
  24. DIM y(400) AS LONG'Largest number of x/y line pairs expected.
  25. DIM origx(400) AS LONG
  26. DIM origy(400) AS LONG
  27. DIM lastx(5000) AS LONG
  28. DIM lasty(5000) AS LONG
  29.  
  30. 'Dimension integer variables for speed in extraction loop
  31. DIM tyflag AS INTEGER
  32. DIM id AS INTEGER
  33. DIM k AS INTEGER
  34. DIM k1 AS INTEGER
  35. DIM i AS INTEGER
  36. DIM txt$(3, 11)
  37. txt$(1, 1) = "Water Bodies (color 11)"      'Output as WB
  38. txt$(1, 2) = "Rivers and streams (color 3)" 'Output as ST
  39.  
  40. txt$(2, 1) = "AIRPORTS"                     'Output as CF
  41.  
  42. txt$(3, 1) = "1) Interstate freeways"     'All output as RD
  43. txt$(3, 2) = "2) U.S. Highways"
  44. txt$(3, 3) = "3) State Routes"
  45. txt$(3, 4) = "4) County Routes"
  46. txt$(3, 5) = "5) Primary Routes"
  47. txt$(3, 6) = "6) Secondary Routes"
  48. txt$(3, 7) = "7) Roads or streets (class 3)"
  49. txt$(3, 8) = "8) Roads or streets (class 4)"
  50. txt$(3, 9) = "9) Trails (other than four wheel drive)"
  51. txt$(3, 10) = "10) Trails (four wheel drive)"
  52.  
  53. REM SCREEN 9
  54. REM on error goto errorfix
  55. CLS
  56. PRINT "This program will take the output files from the 100,000 USGS EXTRACT"
  57. PRINT "program and generate categories of intermediate files that look like"
  58. PRINT "the 2,000,000:1  GRAPHIC format.  These files can then be pulled into"
  59. PRINT "the APRS MAPFIX program using the alt-U command."
  60. PRINT
  61. PRINT "The source file (output by the CD ROM EXTRACT program) will identify the type"
  62. PRINT "of data it contains (water, roads, or airports).  This program will then auto-"
  63. PRINT "matically generate and name output files of the form PRE#TY.GRF where:"
  64. PRINT "           PRE  is a  user defined prefix for all files in this run"
  65. PRINT "           #    is the feature category (1-10 for roads)"
  66. PRINT "           TY   is either WB, ST, RD or CF"
  67. PRINT
  68. PRINT "This naming convention is compatible with the 2,000,000 and MAPFIX format."
  69. PRINT
  70.  
  71. top:
  72.  id = 0 'Line ID counter
  73.  IF tyflag = 0 THEN
  74.     'Increment TYflag for each loop to make different files for each category
  75.     'Files are named like BA4HYDxx or BA4RDSxx or BA4MTFxx (misc Transprtn)
  76.     'Where the xx are numbers
  77.     INPUT "Enter path and File name of source data"; F$
  78.            'F$ = "d:\severn\" + F$
  79.            'F$ = "SJ2RDF05"
  80.  
  81.     INPUT "Enter file name PREFIX to be used in all output files."; Fopre$
  82.            Fopre$ = LEFT$(Fopre$, 4)
  83.     PRINT
  84.     tyflag = 0'for debugging (this was stiill = 2 as distroed in conv100b
  85.  
  86.  END IF
  87.  tyflag = tyflag + 1
  88.  OPEN F$ FOR INPUT AS #3
  89.  PRINT "Corner coordinates:"
  90.  DO WHILE NOT EOF(3)
  91.     LINE INPUT #3, a$    'Look for Quadrant calibration data
  92.     b$ = LEFT$(a$, 2)
  93.     IF b$ = "SW" THEN
  94.        swlat = VAL(MID$(a$, 7, 11))
  95.        swlon = ABS(VAL(MID$(a$, 19, 11)))
  96.        swx = VAL(MID$(a$, 39, 11))
  97.        swy = VAL(MID$(a$, 51, 11))
  98.        PRINT "SW: "; swlat, swlon, swx, swy
  99.     ELSEIF b$ = "NW" THEN
  100.        nwlat = VAL(MID$(a$, 7, 11))
  101.        nwlon = ABS(VAL(MID$(a$, 19, 11)))
  102.        nwx = VAL(MID$(a$, 39, 11))
  103.        nwy = VAL(MID$(a$, 51, 11))
  104.        PRINT "NW: "; nwlat, nwlon, nwx, nwy
  105.     ELSEIF b$ = "NE" THEN
  106.        nelat = VAL(MID$(a$, 7, 11))
  107.        nelon = ABS(VAL(MID$(a$, 19, 11)))
  108.        nex = VAL(MID$(a$, 39, 11))
  109.        ney = VAL(MID$(a$, 51, 11))
  110.        PRINT "NE: "; nelat, nelon, nex, ney
  111.     ELSEIF b$ = "SE" THEN
  112.        selat = VAL(MID$(a$, 7, 11))
  113.        selon = ABS(VAL(MID$(a$, 19, 11)))
  114.        sex = VAL(MID$(a$, 39, 11))
  115.        sey = VAL(MID$(a$, 51, 11))
  116.        PRINT "SE: "; selat, selon, sex, sey
  117.     END IF
  118.     IF b$ = "SE" THEN EXIT DO
  119.  LOOP
  120.  
  121.  'Determine type of map so proper line type will be extracted.
  122.  tynum = 0' type map files we are reading.
  123.  TY$ = "" ' TYpe file name to be output (WB, ST, CF, or RD)
  124.  
  125.  REM roadflag = 0' zero flag for roads and airports
  126.  PRINT
  127.  DO WHILE NOT EOF(3)
  128.     LINE INPUT #3, a$
  129.     IF LEFT$(a$, 5) = "HYDRO" THEN
  130.                  tynum = 1: Endflag = 2
  131.                       IF tyflag = 1 THEN TY$ = "WB" ELSE TY$ = "ST"
  132.     END IF
  133.  
  134.     IF LEFT$(a$, 4) = "PIPE" THEN tynum = 2: Endflag = 1: TY$ = "CF"'AIRPORTS
  135.                       'Named CF to match cultural features in 2,000,000 format
  136.     IF LEFT$(a$, 5) = "ROADS" THEN tynum = 3: Endflag = 10: TY$ = "RD"
  137.     IF LEFT$(a$, 1) = "N" THEN EXIT DO ' Found start of node data
  138.     PRINT LEFT$(a$, 20)
  139.  LOOP
  140.  
  141. convert: 'Calculate the x/y meters to lat/long conversion factors
  142.    basex = sex: basey = ney
  143.    baselat = nelat: baselon = selon
  144.  
  145.    xdelta = sex - swx: ydelta = ney - sey
  146.    londelta = swlon - selon: latdelta = nelat - selat
  147.  
  148.    lonfac = londelta / xdelta: latfac = latdelta / ydelta
  149.  
  150. ' Added for UTM grid error correction
  151.    yerr = ney - nwy
  152.    xerr = sex - nex
  153.  
  154.    PRINT
  155.    PRINT "baselat ="; baselat; TAB(30); "baselon ="; baselon
  156.    PRINT "base x ="; basex; TAB(30); "base y ="; basey
  157.    PRINT "xdelta = "; xdelta; TAB(30); "ydelta ="; ydelta
  158.    PRINT "londelta ="; londelta; TAB(30); "latdelta ="; latdelta
  159.    PRINT "lonfac ="; lonfac; TAB(30); "latfac ="; latfac
  160.  
  161.  gotflag = 0
  162.  IF tynum = 3 THEN num$ = MID$(STR$(tyflag), 2) ELSE num$ = ""
  163.  FO$ = Fopre$ + num$ + TY$ + ".grf"
  164.  OPEN FO$ FOR OUTPUT AS #4
  165.  PRINT
  166.  PRINT "Now doing "; txt$(tynum, tyflag); "   Outputting to file: "; FO$
  167.  PRINT
  168.  PRINT "Skipping NODE data looking for LINE data....";
  169.  
  170.  DO WHILE NOT EOF(3)
  171.     LINE INPUT #3, a$
  172.     b$ = LEFT$(a$, 1)
  173.     IF b$ = "L" THEN  'We found the start of line segment data
  174.        IF gotflag = 0 THEN
  175.           gotflag = 1: PRINT "GOT IT.  Now doing lines...": PRINT
  176.           PRINT "LineID:#pairs..."
  177.        END IF
  178.        pairs = VAL(MID$(a$, 43, 6))
  179.        attrib = VAL(MID$(a$, 49, 6))
  180.       
  181.        'If there are no attributes then get another line
  182.        'This line is probably just connecting two nodes and is not a road, etc.
  183.     ' IF attrib <> 0 THEN
  184.      
  185.           'PRINT "Pairs =", pairs  '"Pairs" of x/y coordinates
  186.           'PRINT "Attributes ="; attrib   'number of attributes
  187.        
  188.           'Get the line with x/y data
  189.           k = 0   'This is the pointer to move through the line of data
  190.           LINE INPUT #3, a$
  191.           FOR i = 1 TO pairs
  192.               k = k + 1
  193.               z = 25 * (k - 1)
  194.               origx(i) = VAL(MID$(a$, z + 1, 12))
  195.               origy(i) = VAL(MID$(a$, z + 13, 12))
  196.               'There is a maximum of 3 pairs of x/y coordinates on a line.
  197.               'If there are more than 3 pairs get another line.
  198.               IF k = 3 AND pairs > i THEN k = 0: LINE INPUT #3, a$
  199.           NEXT i
  200.           
  201.           IF attrib > 0 THEN          'Recover attributes (i.e. road type, etc)
  202.              LINE INPUT #3, a$
  203.             
  204.              IF attrib = 1 THEN
  205.                major$ = MID$(a$, 3, 5)
  206.                minor$ = MID$(a$, 10, 4)
  207.              END IF
  208.             
  209.              'If first attribute code is "incidental feature" recover second
  210.              'code.
  211.              IF attrib > 1 THEN
  212.                IF VAL(MID$(a$, 3, 5)) = 179 THEN
  213.                  major$ = MID$(a$, 14, 5)
  214.                  minor$ = MID$(a$, 21, 4)
  215.                ELSE
  216.                  major$ = MID$(a$, 3, 5)
  217.                  minor$ = MID$(a$, 10, 4)
  218.                END IF
  219.  
  220.                'For cases where both first & second attrib is "incidental"
  221.                IF VAL(major$) = 179 AND attrib > 2 THEN
  222.                  major$ = MID$(a$, 26, 5)
  223.                  minor$ = MID$(a$, 33, 4)
  224.                END IF
  225.              END IF
  226.             
  227.              m = VAL(major$)
  228.              n = VAL(minor$)
  229.           END IF
  230.          
  231.           doit = 0
  232.           
  233.           IF tynum = 1 THEN     ' Water
  234.              IF tyflag = 1 AND m = 50 AND (n = 200 OR n = 201) THEN doit = 1
  235.              IF tyflag = 1 AND m = 50 AND (n = 605 OR n = 606) THEN doit = 1
  236.              IF tyflag = 2 AND m = 50 AND n = 412 THEN doit = 1
  237.           ELSEIF tynum = 2 THEN ' Airports
  238.              IF tyflag = 1 AND m = 190 AND n = 403 THEN doit = 1
  239.           ELSEIF tynum = 3 THEN ' Roads
  240.              'skip coincident road features m=179
  241.              IF tyflag = 1 AND m = 172 THEN doit = 1'Interstates
  242.              IF tyflag = 2 AND m = 173 THEN doit = 1'U.S. Highways
  243.              IF tyflag = 3 AND m = 174 THEN doit = 1'State Highways
  244.              IF tyflag = 4 AND m = 176 THEN doit = 1'County Routes
  245.              IF tyflag = 4 AND m = 177 THEN doit = 1'(alpha num. in Calif)
  246.             
  247.              IF m = 170 THEN
  248.                 IF tyflag = 5 AND m = 170 THEN
  249.                    IF n = 201 THEN doit = 1
  250.                    IF n = 202 THEN doit = 1
  251.                    IF n = 203 THEN doit = 1
  252.                    IF n = 204 THEN doit = 1
  253.                 ELSEIF tyflag = 6 AND m = 170 THEN
  254.                    IF n = 205 THEN doit = 1
  255.                    IF n = 206 THEN doit = 1
  256.                    IF n = 207 THEN doit = 1
  257.                    IF n = 208 THEN doit = 1
  258.                 ELSEIF tyflag = 7 AND n = 209 THEN doit = 1
  259.                 ELSEIF tyflag = 8 AND n = 210 THEN doit = 1
  260.                 ELSEIF tyflag = 9 AND n = 211 THEN doit = 1
  261.                 ELSEIF tyflag = 10 AND n = 212 THEN doit = 1
  262.                 END IF
  263.              END IF
  264.           END IF
  265.           IF doit THEN
  266.  
  267.           'Check if reversing the order is needed so that the JOIN command
  268.           'in MAPFIX will work. (Checking if last points x/y same as first point
  269.           'in this segment.)
  270.           reverse = 1
  271.           IF id >= 2 THEN
  272.              FOR k1 = 1 TO id
  273.                  IF origx(1) = lastx(k1) AND origy(1) = lasty(k1) THEN
  274.                     PRINT "*"; : lc = lc + 1
  275.                     FOR i = 1 TO pairs
  276.                         x(i) = origx(i)
  277.                         y(i) = origy(i)
  278.                     NEXT i
  279.                     k1 = id
  280.                     reverse = 0
  281.                  END IF
  282.              NEXT k1
  283.           END IF
  284.         
  285.           IF reverse THEN
  286.              'Reverse the order - last set of coordinates becomes first set.
  287.              'Otherwise map segments will not be properly joined.
  288.              FOR i = 0 TO pairs
  289.                  x(i + 1) = origx(pairs - i)
  290.                  y(i + 1) = origy(pairs - i)
  291.              NEXT i
  292.           END IF
  293.         
  294.           'Print header for line
  295.           id = id + 1' Increment the line identifier
  296.           rank = VAL(MID$(minor$, 2, 2))
  297.           firstattrib = VAL(LEFT$(major$, 5))
  298.           submajor = VAL(LEFT$(minor$, 2))
  299.        
  300.           'Convert the 1 to 100,000 scale attributes to those used by 1 to 2,000,000.
  301.           'This is so the highway colors plot correctly.
  302.    IF firstattrib = 172 THEN rank = 1: att$ = "I-": 'Interstate
  303.    IF firstattrib = 173 THEN rank = 19: att$ = "US": 'U.S. route
  304.    IF firstattrib = 174 THEN rank = 23: att$ = "SR": 'State route
  305.    IF firstattrib = 176 THEN rank = 23: att$ = "CO": 'County route
  306.    IF firstattrib = 170 THEN rank = 25: att$ = " ": 'state secondary unnamed
  307.          
  308.           IF lc > 300 THEN lc = 0: CLS : PRINT "Major, Minor"; major$; minor$
  309.           PRINT RTRIM$(STR$(id)); ":"; LTRIM$(STR$(pairs)); : lc = lc + 1
  310.           PRINT #4, USING "#######"; id;
  311.           PRINT #4, USING "##"; rank;
  312.           PRINT #4, USING "######"; pairs;
  313.             'PRINT #4, USING "###"; firstattrib;
  314.             'PRINT #4, USING "##"; submajor
  315.           'Following prints Hwy type and number, i.e. US101
  316.           PRINT #4, USING "\\###"; att$; VAL(minor$);
  317.  
  318.           'Convert from x/y meters to decimal lat/long
  319.           FOR i = 1 TO pairs
  320.               'Find the delta from base x and y coordinates
  321.               dex = basex - x(i)
  322.               dey = basey - y(i)
  323.  
  324.   'Added for UTM grid error correction
  325.          yfac = 1 - (dey / ydelta)
  326.          xfac = dex / xdelta
  327.          'x error is tied to y. Less y = more error
  328.          xerrfac = xerr * yfac
  329.          'y error is tied to x. Less x = more error
  330.          yerrfac = yerr * xfac
  331.          dey = dey - yerrfac
  332.          dex = dex - xerrfac
  333.             
  334.         
  335.               'Convert the delta x/y into lat/long delta
  336.               delat = dey * latfac
  337.               delon = dex * lonfac
  338.  
  339.               'Add the lat/long delta to the base decimal lat/long
  340.               lat = baselat - delat
  341.               lon = baselon + delon
  342.  
  343.               'Convert decimal lat/long to lat/long in degrees, minutes, and seconds.
  344.               latdeg = INT(lat)
  345.               latmin = (lat - latdeg) * 60
  346.               latminint = INT(latmin)
  347.               latsec = (latmin - latminint) * 60
  348.               'PRINT latmin, latminint; "  ";
  349.               londeg = INT(lon)
  350.               lonmin = (lon - londeg) * 60
  351.               lonminint = INT(lonmin)
  352.               lonsec = (lonmin - lonminint) * 60
  353.               'PRINT lonmin, lonminint
  354.          
  355.               'Following for debug
  356.               'PRINT USING "##°"; latdeg;
  357.               'PRINT USING "##'"; latminint;
  358.               'PRINT USING "##''N  "; latsec;
  359.               '
  360.               ' PRINT USING "###°"; londeg;
  361.               ' PRINT USING "##'"; lonminint;
  362.               ' PRINT USING "##''W"; lonsec
  363.           
  364.               'Check output format to match 1 to 2,000,000 graphics format which
  365.               'APRS MAPFIX expects
  366.               PRINT #4, USING "##"; latdeg; : IF latdeg < 30 THEN PRINT "******"; latdeg
  367.               PRINT #4, USING "##"; latminint;
  368.               PRINT #4, USING "##N"; latsec;
  369.               PRINT #4, USING "###"; londeg;
  370.               PRINT #4, USING "##"; lonminint;
  371.               PRINT #4, USING "##W"; lonsec;
  372.               PRINT #4, USING "#####"; i; ' sequence counter (counts up to the number of pairs).
  373.           NEXT i
  374.       
  375.           'Save the last x/y for checking later on
  376.           lastx(id) = x(i - 1)
  377.           lasty(id) = y(i - 1)
  378.           END IF' matches doit
  379.       ' END IF'matches atribute<>0
  380.     END IF ' This is from the IF statement which checked for an "L"
  381.  LOOP
  382.  
  383.  'INPUT "Press any key to continue"; in$ 'for debugging
  384.  'FOR x = 1 TO 50000: NEXT x 'For debugging
  385.  CLOSE #3
  386.  CLOSE #4
  387.  PRINT
  388.  PRINT "Finished!  OUTPUT IS IN FILE NAMED: "; FO$
  389.  PRINT
  390.  IF tyflag < Endflag THEN GOTO top
  391.  INPUT "Convert another file (Y)"; a$
  392.  IF UCASE$(a$) = "Y" THEN tyflag = 0: GOTO top
  393.  SYSTEM
  394. END
  395.  
  396. 'Put the error routine here
  397. Errorfix:
  398.  
  399.